Attribute VB_Name = "modODBCKnet"
'---------------------------------------------------------------------------------------
'Module     : modODBC
'Date       : 05/18/2004
'Updated    : 02/21/2005
'Author     : Chris Elwell
'Purpose    : This is an example of a CIC integration module. This is for demostration
'           purposes only. You must write the code required to get/writeback data from/to
'           your customer's data source.
'
'           This example uses the FSMSClientTest.mdb. A DSN is setup as FSMSClientTest.
'           Regardless of the integration method, CICs must have a module that contains
'           specific sub routines. All of these subs/functions listed below must exist
'           as they are called from the main program.
'           Public Function GetData(ByVal strKey As String) As Boolean - this routine is
'               called when the Order ID field loses focus. This is where you would code to
'               get order data from a customer and populate the screen fields. You can create
'               and call as many support routines as necessary. Also, this routine should
'               return a boolean True if getting the order data was succesful and a boolean
'               False if it was not.
'           Public Sub WriteReply() - this is called after a successful shipment. A typical
'               use would be to write FXRS reply data back to a customer's system, but can be
'               used for anything that you want to have happen after a pckage is shipped.
'           Public Sub WriteError() - this is called after an error is returned from FXRS.
'           Public Sub WriteDelete(ByVal strTracking As String) - this is called after a
'               package is successfully deleted.
'           Public Sub AfterClose() - this is called after FXRS is closed.
'           Public Sub BeforeClose() - this is called just before an FXRS close transaction
'               is sent.
'Updated:   Public Function BeforeShip() - Return TRUE to continue shipment, False to cancel.
'           Public Sub Initialize() - this is called once on program execution.
'           Public Sub BeforeBatch() - this is called before processing a batch file.
'           Public Sub BeforeBatchShip() - this is called before each individual batch transaction.
'New:       Public Sub AfterAddrLookup() - this is called after cboCustID, cboContact, and cboCompany lose focus
'New:       Public Sub AfterDeptLostFocus() - this is called after cboDept or f38 loses focus.
'
' 2005-04-20, JFW, Added AddDSN for integration database.
' 2006-11-07, JFW, Add order to MPS select to preserve package order
' 2007-04-13, JFW, Allow for custom screen display, AfterConnect
' 2007-05-23, JFW, CTI intetration for Mike.
'
'---------------------------------------------------------------------------------------


' See Project properties for Conditional Compilation
#If Knet Then

Option Explicit

'Dim m_CNIn As ADODB.Connection
'Dim m_CNInA As ADODB.Connection
'Dim m_CNIn9 As ADODB.Connection
'Dim strCNIn As String

'Dim m_CNOut As ADODB.Connection
'Dim m_RSCustomer As ADODB.Recordset
'Dim m_rs As ADODB.Recordset
'Dim m_strLine As String
Dim m_strKeyValue As String

Dim mfrmSocket As frmSocket

Dim mobjODBCTrans As frmODBCTrans

'2/8/05 - API function declaration to add DSN to system used in AddDSN() function.
'Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal _
'   hwndParent As Long, ByVal fRequest As Long, ByVal _
'   lpszDriver As String, ByVal lpszAttributes As String) As Long

'+
' 2006-09-20, JFW, From Copernicus FXI
' Declare object(s)
'Public g_strCustNo As String        'Hold Customer Number
'Public g_strPONo As String          'Hold Customer PO Number
'Public g_strRefNo As String         'Hold Customer Reference Number
'Public g_strCountry As String       'Hold shipto Country
'Public g_strZip As String           'Holds zip code
'Public g_strEmail As String         'Hold Email address
'Public g_strEmail2 As String        'Hold Email address
'Public g_blnServiceOrder As Boolean 'Flage for email
'~


'---------------------------------------------------------------------------------------
' Procedure : AddDSN
' DateTime  : 2/8/2005
' Purpose   : Adds the FSMSClient v720.3 DSN
' Call from : Form_Load
'---------------------------------------------------------------------------------------
'
Private Function AddDSN() As Boolean
    On Error GoTo EH

    Dim ret As Long
    Dim Driver As String
    Dim Attributes As String

'    If GetSystemName = "WINXPC9CA96EA3" Then
'        Driver = "Microsoft Access Driver (*.mdb)"
'        Attributes = Attributes & "DBQ=C:\Documents and Settings\563774\My Documents\FXI\Projects\Linda\AllSeating.mdb" & Chr(0)
'        Attributes = Attributes & "DSN=FedExAllSeating" & Chr(0)
'        Attributes = Attributes & "DESCRIPTION=FSMS Client All Seating ship data" & Chr(0)
'
'        ret = SQLConfigDataSource(0, 4, Driver, Attributes)
'        If ret <> 1 Then
'            AddDSN = False
'        Else
'            AddDSN = True
'        End If
'
'    Else
        ' 2007-05-23, JFW, no autodefine, DSN=FEDEX;UID=sa;PWD=sa
        AddDSN = True
'    End If

    Exit Function
EH:
    AddDSN = False

End Function
'

Public Function ClearCommodity() As Boolean

End Function
'



' 2012-01-19, JFW, New for UCS.
Public Function AfterScreenChange(f As Form) As Boolean

End Function


' 2012-01-19, JFW, New for UCS.
Public Function BeforeGotFocus(f As Form, c As Control) As Boolean
End Function


' 2011-05-05, JFW, For Scapa
Public Function TDAutoCloseEnabled() As Boolean
    TDAutoCloseEnabled = True
End Function
'


Public Function ClearShipScreen() As Boolean

    m_strKeyValue = ""
                
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetData(ByRef strTransIn As String) As String
    On Local Error GoTo Handler

    Dim rs As New ADODB.Recordset
    Dim strOpenShip As String
    
    m_strKeyValue = strTransIn

    If Not Connect Then Exit Function   'set conection and recordset
    
    g_strErrorLocation = "modODBCKnet:GetData"
    
    ' Transform transaction
    If CLng(g_str0) = 20 Then
        If g_str50 = "US" Then
            ' TD shipment
            ' Add TD to the trans
            TransactionStripTag strTransIn, 99
            TransactionStripTag strTransIn, 541
            TransactionStripTag strTransIn, 542
            TransactionBuilder strTransIn, 541, "NNNYNNNNN"
            TransactionBuilder strTransIn, 542, g_strTDOpenShip
            TransactionBuilder strTransIn, 99, ""
        Else
            ' other shipment
        End If
    ElseIf CLng(g_str0) = 23 Then
        If strOpenShip = "" Then
            rs.Open "select OpenShipIndex, g_str29, g_str10 from TD where g_str29 = '" & g_str29 & "'", g_connFSMSClient
            If Not rs.BOF Then
                strOpenShip = rs!OpenShipIndex
                g_str10 = rs!g_str10
            Else
                rs.Close
                rs.Open "select OpenShipIndex, g_str29, g_str10 from Shipments where g_str29 = '" & g_str29 & "'", g_connFSMSClient
                If Not rs.BOF Then
                    g_str10 = rs!g_str10
                End If
            End If
        End If
        
        TransactionStripTag strTransIn, 99
        TransactionBuilder strTransIn, 10, g_str10
        If strOpenShip <> "" Then
            strTransIn = Replace(strTransIn, "0,""23""", "0,""020""")
            strTransIn = Replace(strTransIn, "0,""023""", "0,""020""")
            TransactionBuilder strTransIn, 541, "NNNNNNYNN"           'Open Ship Flags
            TransactionBuilder strTransIn, 542, strOpenShip
        End If
        TransactionBuilder strTransIn, 99, ""                     'End of Transaction
    End If
    
    GetData = strTransIn

Release:
    ' call kill
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetData"
    Call Kill
    Resume Release
    Resume

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Sub GetDataToShip()

    On Local Error GoTo Handler


    g_strErrorLocation = "Done"
Release:
    ' call kill
    Exit Sub
Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteReply()
' DateTime  : 2/14/2005
' Purpose   : REQUIRED SUB. Called after a successful ship transaction.
'             This example shows how to obtain multiple occurrence fields from the
'             FXRS reply and how to obtain multiple occurrence fields included in the
'             input transaction but not returned in the FXRS reply.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReply()

    On Local Error GoTo Handler

    Dim intCount As Long
    Dim strSelect As String

    m_strKeyValue = ""

Release:
    Exit Sub

Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.WriteReply"
    Call Kill
    Resume Release

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteError()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an FXRS Error reply transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteError()
    MsgBox "Shipping Error: " & g_str3, vbCritical, "FSMS Error"
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteDelete()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             successful FXRS Delete.
'---------------------------------------------------------------------------------------
'
Public Sub WriteDelete(ByVal strTracking As String)
'Called:    frmShip Parsecomplete event on FSMS 123 reply
'Purpose:   update customer table on void
    On Local Error GoTo Handler

Release:
   ' call kill
   Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.WriteDelete"
    Call Kill
    Resume Release

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : Connect()
' DateTime  : 7/5/2004
' Purpose   : Open connection to ODBC test DSN. Instantiate module level recordset.
'---------------------------------------------------------------------------------------
'
Private Function Connect() As Boolean
    On Local Error GoTo Handler
    Dim strDSN As String
    Dim boolSecondTry As Boolean

    Connect = True

    Exit Function

Handler:
    If Not boolSecondTry Then
        boolSecondTry = True
        If Err.number = -2147467259 Then
            Call AddDSN
            Resume
        End If
    End If
    MsgBox Err.Description, , "modODBC.Connect"
    Call Kill        'kill connection and recordset

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : Kill()
' DateTime  : 7/5/2004
' Purpose   : Close connection and recordset objects and set = to nothing.
'---------------------------------------------------------------------------------------
'
Public Sub Kill()
    On Local Error GoTo Handler

    Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.Kill"

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerify()
' DateTime  : 5/12/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             Address Verification. Three possible status codes are passed. See comments
'             below.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerify(ByVal intStatusCode As Integer)

    Select Case intStatusCode
        'Address is verfified
        Case 1

        'Soft error
        Case 2

        'Hard error
        Case 3

    End Select

End Sub

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerifyUpdate()
' DateTime  : 9/13/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an address has been updated on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerifyUpdate()

End Sub


'---------------------------------------------------------------------------------------
' Procedure : AfterBatchShip()
' DateTime  : 10/28/2005
' Purpose   : REQUIRED SUB. Called just after a batch transaction has been processed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatchShip()

End Sub
'---------------------------------------------------------------------------------------
' Procedure : AfterBatch()
' DateTime  : 4/6/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a batch shipment has been completed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatch()

End Sub


'---------------------------------------------------------------------------------------
' Procedure : AfterClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Sub AfterClose()

End Sub
'

' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterConnect()

    ' For Manulife, go to customer lookup
    ' Call frmShip.ToggleLookup(True)

    If Not mfrmSocket Is Nothing Then
        Unload mfrmSocket
        Set mfrmSocket = Nothing
        DoEvents
    End If
    Set mfrmSocket = New frmSocket
    
End Sub


' 2011-02-01, JFW, Clear DG disclaimer automatically.
Public Function AfterDGDisclaimer() As Boolean
    AfterDGDisclaimer = True
End Function


' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterDisconnect()

    On Error Resume Next

    If Not mobjODBCTrans Is Nothing Then mobjODBCTrans.mstrState = "Start"
    
    Unload mfrmSocket
    Set mfrmSocket = Nothing
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLoadServices()
' DateTime  : 5/17/2011
' Purpose   : Remove or add custom services.
' 2011-05-17, JFW, New for Scapa
'---------------------------------------------------------------------------------------
'
Public Sub AfterLoadServices(c1 As ComboBox)

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterLocationChange()
' DateTime  : 3/06/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             the shipping Location has been changed on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLocationChange()

    g_strErrorLocation = "ODBCAllSeating.AfterLocationChange.In"
    With frmShip
        If .cboLocationName(0).Text = "ALLSEATING" Then
            If Left(.f50.Text, 2) <> "US" Then
                .f50.Text = "US"
                DoEvents
                If g_strTDMasterTrkNbr <> "" Then
                    .f1482.Value = 1
                End If
                DoEvents
            End If
        End If
    End With
    g_strErrorLocation = "ODBCAllSeating.AfterLocationChange.Out"

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLostFocus(c1 As Control)

    If c1.name = "f38" Then
        'g_clsReg.SetRegistryValue "Carry_f38", frmShip.f38, REG_SZ
    End If
    If c1.name = "f1273" Then
        'g_clsReg.SetRegistryValue "Carry_f1273", Left(frmShip.f1273.Text, 2), REG_SZ
    End If
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterRateQuote()
' DateTime  : 20071106-01
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a rate quote.
'---------------------------------------------------------------------------------------
'
Public Sub AfterRateQuote()

End Sub


'---------------------------------------------------------------------------------------
' Procedure : BeforeClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed before
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Function BeforeClose() As Boolean

    BeforeClose = True

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeShip()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShip(Optional TransString As String = "") As Boolean

    Dim objRetVal As VbMsgBoxResult

    With frmShip
        If Left(.f50.Text, 2) <> "CA" Then
            If Not IsNumeric(Trim(.txtTotCustVal)) Then
                objRetVal = MsgBox("This " & IIf(.f1482.Value = 1, "TD", "Intl") & " shipment has no customs value.  Please return and correct.")
            ElseIf CDbl(Trim(.txtTotCustVal)) <= 0 Then
                objRetVal = MsgBox("This " & IIf(.f1482.Value = 1, "TD", "Intl") & " shipment has no customs value.  Please return and correct.")
            ElseIf CDbl(Trim(.txtTotCustVal)) <= 1 Then
                objRetVal = MsgBox("This " & IIf(.f1482.Value = 1, "TD", "Intl") & " shipment has little customs value.  OK or cancel to return and correct.", vbOKCancel + vbDefaultButton2)
                If objRetVal = vbOK Then
                    BeforeShip = True
                End If
            Else
                BeforeShip = True
            End If
        Else
            BeforeShip = True
        End If
        If .f38.Text = "" Then
            frmMsgBox.ShowMessage "Department is required.", 2000
            DoEvents
            If .SSTab1.Tab <> 0 Then
                .SSTab1.Tab = 0
                DoEvents
            End If
            .f38.SetFocus
            DoEvents
            BeforeShip = False
        End If
    End With

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeShipTrans()
' DateTime  : 8/7/2008
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShipTrans(ByRef TransString As String) As Boolean
    
    Dim lngMsgBoxResult As VbMsgBoxResult
    BeforeShipTrans = True
    
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BuildCustomSPLabel()
' DateTime  : 20070620-04
' Purpose   : REQUIRED SUB. Can be used as hook to create custom EPL or ZPL buffer labels
'             for SmartPost.
'---------------------------------------------------------------------------------------
'
Public Function BuildCustomSPLabel(ByVal strLabel As String) As String

    BuildCustomSPLabel = strLabel

End Function


Public Sub EditBoxLostFocus(objControl As Control)

End Sub


'---------------------------------------------------------------------------------------
' Procedure : Initialize()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution.
'---------------------------------------------------------------------------------------
'
Public Sub Initialize(Optional f1 As Form)

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeBatch()
' DateTime  : 8/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution. Called before an entire batch is processed.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatch() As Boolean

    BeforeBatch = True

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeBatchShip()
' DateTime  : 8/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution. Called just before a batch transaction is sent to the server.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatchShip() As Boolean

    BeforeBatchShip = True

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrLookup()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboCustID, cboContact, or cboCompany loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrLookup()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterDeptLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterDeptLostFocus()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : GetPickupData()
' DateTime  : 1/30/2006
' Purpose   : REQUIRED SUB. Called from frmAddTags.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetPickupData(ByVal strKey As String) As Boolean

    GetPickupData = True

End Function


'---------------------------------------------------------------------------------------
' Procedure : WriteBatchEditReply()
' DateTime  : 1/17/2006
' Purpose   : REQUIRED SUB. Called after a successful Batch Error Edit transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBatchEditReply()

End Sub
' Procedure : WriteTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteTagReply()

End Sub
' Procedure : WriteCancelTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Cancel Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteCancelTagReply()

End Sub
'---------------------------------------------------------------------------------------
' Procedure : WriteReturnDelete()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label delete transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnDelete(ByVal strTracking As String)

End Sub

'---------------------------------------------------------------------------------------
' Procedure : WriteReturnReply()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnReply()

End Sub
'---------------------------------------------------------------------------------------
' Procedure : WriteBOLReply()
' DateTime  : 1/11/2006
' Purpose   : REQUIRED SUB. Called after a successful FedEx Freight BOL transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBOLReply()

End Sub



'---------------------------------------------------------------------------------------
' Procedure : MsgBox()
' DateTime  : 2010-07-18
' Purpose   : Optional function.  Override all uses of MsgBox.  Livingston runs lights out.
'---------------------------------------------------------------------------------------
'
Public Function MsgBox(strPrompt As String, Optional lngMsgBoxStyle As VbMsgBoxStyle = vbOKOnly, Optional strTitle As String = "") As VbMsgBoxResult

    On Error Resume Next

    ' This is what all other integrations do (by omission)
    ' MsgBox = Interaction.MsgBox(strPrompt, lngMsgBoxStyle, strTitle)
        
    DebugPrint IIf(strTitle <> "", strTitle & ", ", "") & strPrompt
    If (lngMsgBoxStyle And vbYesNo) = vbYesNo Then
        MsgBox = vbYes
    End If
    
End Function
'

#End If





